Just Call Me Internet/Just Call Me Internet.iso/prog/atari/m2/cat3src/magic/i/mttextfi.i

Modula Implementation | 1997-10-26 | 14.3 KB | 473 lines

(*----------------------------------------------------------------------*
 *                                                                      *
 *  MAGICTOOLS   Modula's  All purpose  GEM  Interface  Cadre  Toolbox  *
 *               ÿ         ÿ            ÿ    ÿ          ÿ               *
 *----------------------------------------------------------------------*
 * Version 3.30  02.02.1992     (C)90/91/92 by Peter Hellinger Software *
 *----------------------------------------------------------------------*
 *            Dieses Modul ist urheberrechtlich geschtzt.              *
 *                                                                      *
 * Die Ver”ffentlichung des Quelltextes oder Teilen daraus, sowie die   *
 * Verbreitung des bersetzten, nicht gelinkten Codes in schriftlicher, *
 * oder maschinenlesbarer Form, insbesondere in Zeitschriften, Mail-    *
 * boxen oder anderen Medien bedarf der ausdrcklichen schriftlichen    *
 * Einverst„ndnisserkl„rung des Autors.                                 *
 *                                                                      *
 * Die Verbreitung des Moduls als Teil eines gelinkten Programms ist    *
 * fr Lizenznehmer ausdrcklich erlaubt!  Der Autor beh„lt sich das    *
 * Recht vor, diese Erlaubnis jederzeit und ohne Angaben von Grnden zu *
 * widerrufen.                                                          *
 *----------------------------------------------------------------------*)

IMPLEMENTATION MODULE mtTextfiles;

(*----------------------------------------------------------------------*
 * Int. Vers | Datum    | Name | Žnderung                               *
 *-----------+----------+------+----------------------------------------*
 *  3.00     | 18.01.92 |  Hp  |                                        *
 *-----------+----------+------+----------------------------------------*)



(* IMPLEMENTATION FšR  >>> Megamax-Modula-2 <<< *)
(*                                              *)
(*$R-   Range-Checks                            *)
(*$S-   Stack-Check                             *)
(*                                              *)
(*----------------------------------------------*)






FROM MagicSys   IMPORT  Nil, Null, Bit0, Bit1, Bit2, Bit3, Bit4, Bit5, Bit6,
                        Bit7, Bit8, Bit9, Bit10, Bit11, Bit12, Bit13, Bit14,
                        Bit15, LOC, Byte, ByteSet, sWORD, sINTEGER, sCARDINAL,
                        sBITSET, lINTEGER, lCARDINAL, lWORD, lBITSET,
                        CastToChar, CastToByte, CastToByteset, CastToInt,
                        CastToCard, CastToBitset, CastToWord, CastToLInt,
                        CastToLCard, CastToLBitset, CastToLWord, CastToAddr,
                        TosVersion, Accessory, Basepage, SysHeader, TosDate;








FROM Storage IMPORT ALLOCATE, DEALLOCATE;




FROM SYSTEM             IMPORT  ADDRESS, ADR, TSIZE;
FROM MagicStrings       IMPORT  Assign, Append, Length, Equal;
FROM MagicConvert       IMPORT  CardToStr, IntToStr, LCardToStr,
                                LIntToStr, LRealToStr, RealToStr,
                                StrToCard, StrToInt, StrToLCard,
                                StrToLInt, StrToReal, StrToLReal;
FROM MagicDOS           IMPORT  ReadOnly, Hidden, System, Volume, Folder,
                                Archive, Fcreate, NamePRN, NameAUX, NameCON,
                                Read, Write, StdIn, StdOut, Serial, Printer,
                                Fopen, Fclose, Fread, Fwrite, Fdelete, ReadWrite,
                                SeekStart, SeekPos, SeekEnd, Fseek, Fattrib;


CONST   cMax =          07FFFH;

CONST   cr =            15C;
        lf =            12C;
        ctrlZ =         32C;

TYPE    tBuffer =       POINTER TO ARRAY [0..cMax] OF CHAR;

TYPE    TEXTFILE =      POINTER TO Textfile;
        Textfile =      RECORD
                         name:  ARRAY [0..255] OF CHAR;
                         mode:  Textmode;  (* Modus *)
                         file:  sINTEGER;  (* Filehandle *)
                         size:  lCARDINAL; (* Gr”že des Puffers (0..xxx) *)
                         count: lCARDINAL; (* Anzahl der gelesenen Bytes *)
                         fptr:  lCARDINAL; (* Schreib/Lesepos im File *)
                         bptr:  sCARDINAL; (* Schreib/Lesepos im Puffer *)
                         buff:  tBuffer;   (* Der Puffer pers”nlich *)
                         eof:   BOOLEAN;   (* TRUE, wenn Ende der Datei erreicht *)
                        END;


PROCEDURE OpenTextfile (REF fname: ARRAY OF CHAR; modus: Textmode; puffer: CARDINAL;
                        VAR text: TEXTFILE): BOOLEAN;
VAR i: sINTEGER;
    l: lCARDINAL;
BEGIN
 ALLOCATE (text,  TSIZE (Textfile));
 IF text = NIL THEN  RETURN FALSE;  END;
 WITH text^ DO
  Assign (fname, text^.name);  mode:= modus;  bptr:= 0;  eof:= FALSE;
  IF (puffer = 0) OR (puffer > cMax) THEN  size:= LONG (cMax);
                                     ELSE  size:= LONG (puffer);
  END;
  ALLOCATE (buff,  size);
  IF buff = NIL THEN
    size := 512;
    ALLOCATE (buff, size);
    IF buff = NIL THEN  DEALLOCATE (text, 0);    RETURN FALSE;  END;
  END;
  CASE mode OF
   READ:        file:= Fopen (name, Read);
                IF file < 0 THEN
                 DEALLOCATE (buff, 0);   DEALLOCATE (text, 0);
                 RETURN FALSE;
                END;
                count:= size;
                (* fptr := Fseek (0, file, SeekStart); *)
                fptr := 0;
                Fread (file, count, buff);
                bptr:= 0;  eof:= count = 0;|
   WRITE:       file:= Fcreate (name, {});
                IF file < 0 THEN
                 DEALLOCATE (buff, 0);   DEALLOCATE (text, 0);
                 RETURN FALSE;
                END;
                (* fptr:= Fseek (0, file, SeekStart); *)
                fptr := 0;
                bptr:= 0;  count:= 0;  eof:= FALSE;|
   APPEND:      file:= Fopen (name, {Write});
                IF file < 0 THEN
                 DEALLOCATE (buff, 0);   DEALLOCATE (text, 0);
                 RETURN FALSE;
                END;
                fptr:= Fseek (0, file, SeekEnd);
                bptr:= 0;  count:= 0;  eof:= FALSE;|
  ELSE ;
  END;
 END;
 RETURN TRUE;
END OpenTextfile;

PROCEDURE FlushBuffer (text: TEXTFILE);
BEGIN
 IF text # NIL THEN
  WITH text^ DO
   IF (mode # READ) AND (bptr > 0) THEN
    count:= LONG (bptr);  bptr:= 0;
    Fwrite (file, count, buff);
   END; (* IF *)
  END; (* WITH *)
 END; (* IF *)
END FlushBuffer;

PROCEDURE ReadBuffer (text: TEXTFILE);
BEGIN
 IF text # NIL THEN
  WITH text^ DO
   IF mode = READ THEN
    fptr:= Fseek (0, file, SeekPos);
    count:= size;
    Fread (file, count, buff);
    bptr:= 0;  eof:= count = 0;
   END; (* IF *)
  END; (* WITH *)
 END; (* IF *)
END ReadBuffer;

PROCEDURE CloseTextfile (VAR text: TEXTFILE);
VAR i: sINTEGER;
BEGIN
 IF text # NIL THEN
  FlushBuffer (text);
  i:= Fclose (text^.file);
  DEALLOCATE (text^.buff, 0);
  DEALLOCATE (text, 0);
 END;
END CloseTextfile;

PROCEDURE Reset (text: TEXTFILE);
VAR l: lCARDINAL;
BEGIN
 IF text # NIL THEN
  WITH text^ DO
   CASE mode OF
    READ:   count:= size;
            fptr:= Fseek (0, file, SeekStart);
            Fread (file, count, buff);
            bptr:= 0;  eof:= count = 0;|
    WRITE:  FlushBuffer (text);
            fptr:= Fseek (0, file, SeekStart);
            bptr:= 0;  count:= 0;  eof:= FALSE;|
    APPEND: fptr:= Fseek (fptr, file, SeekStart);
            bptr:= 0;  count:= 0;  eof:= FALSE;|
   END;
  END;
 END;
END Reset;

PROCEDURE Textpos (text: TEXTFILE): lCARDINAL;
VAR l: lCARDINAL;
BEGIN
 IF text # NIL THEN
  RETURN text^.fptr + LONG (text^.bptr);
 END;
END Textpos;

PROCEDURE SetTextpos (text: TEXTFILE; pos: lCARDINAL);
VAR l: lCARDINAL;
BEGIN
 IF text # NIL THEN
  WITH text^ DO
   CASE mode OF
    READ:   count:= size;
            fptr:= Fseek (pos, file, SeekStart);
            Fread (file, count, buff);
            bptr:= 0;  eof:= count = 0;|
    WRITE:  FlushBuffer (text);
            fptr:= Fseek (pos, file, SeekStart);
            bptr:= 0;  count:= 0;  eof:= FALSE;|
    APPEND: FlushBuffer (text);
            fptr:= Fseek (pos, file, SeekStart);
            bptr:= 0;  count:= 0;  eof:= FALSE;|
   END;
  END;
 END;
END SetTextpos;

PROCEDURE EndofText (text: TEXTFILE): BOOLEAN;
BEGIN
 IF text # NIL THEN  RETURN text^.eof;  END;
 RETURN FALSE;
END EndofText;

PROCEDURE WriteChar (text: TEXTFILE; ch: CHAR);
BEGIN
 IF text # NIL THEN
  WITH text^ DO
   IF (mode # READ) THEN
    buff^[bptr]:= ch;  INC (bptr);
    IF LONG (bptr) >= size THEN  FlushBuffer (text);  END;
   END; (* IF *)
  END; (* WITH *)
 END; (* IF *)
END WriteChar;

PROCEDURE WriteLine (text: TEXTFILE; REF string: ARRAY OF CHAR);

VAR c: CARDINAL;
BEGIN
 IF text # NIL THEN
  WITH text^ DO
   IF (mode # READ) THEN
    FOR c:= 0 TO HIGH (string) DO
     IF string[c] = 0C THEN  RETURN  END;
     buff^[bptr]:= string[c];  INC (bptr);
     IF LONG (bptr) >= size THEN  FlushBuffer (text);  END;
    END; (* FOR *)
   END; (* IF *)
  END; (* WITH *)
 END; (* IF *)
END WriteLine;

PROCEDURE WriteConst (text: TEXTFILE; REF string: ARRAY OF CHAR);
BEGIN
 WriteLine (text, string);
END WriteConst;

PROCEDURE WriteLn (text: TEXTFILE);
BEGIN
 WriteChar (text, cr);
 WriteChar (text, lf);
END WriteLn;

VAR string: ARRAY [0..255] OF CHAR;

PROCEDURE WriteCard (text: TEXTFILE; wert: sCARDINAL; len: sCARDINAL);
BEGIN
 CardToStr (wert, len, string);
 WriteLine (text, string);
END WriteCard;

PROCEDURE WriteInt (text: TEXTFILE; wert: sINTEGER; len: sCARDINAL);
BEGIN
 IntToStr (wert, len, string);
 WriteLine (text, string);
END WriteInt;

PROCEDURE WriteLongCard (text: TEXTFILE; wert: lCARDINAL; len: sCARDINAL);
BEGIN
 LCardToStr (wert, len, string);
 WriteLine (text, string);
END WriteLongCard;

PROCEDURE WriteLongInt (text: TEXTFILE; wert: lINTEGER; len: sCARDINAL);
BEGIN
 LIntToStr (wert, len, string);
 WriteLine (text, string);
END WriteLongInt;

PROCEDURE WriteReal (text: TEXTFILE; wert: REAL; len: sCARDINAL);
BEGIN
 RealToStr (wert, len, string);
 WriteLine (text, string);
END WriteReal;

PROCEDURE WriteLongReal (text: TEXTFILE; wert: LONGREAL; len: sCARDINAL);
BEGIN
 LRealToStr (wert, len, string);
 WriteLine (text, string);
END WriteLongReal;

PROCEDURE ReadChar (text: TEXTFILE; VAR c: CHAR);
BEGIN
 IF text # NIL THEN
  WITH text^ DO
   IF (mode = READ) THEN
    IF eof THEN  c:= 0C;  RETURN;  END;
    c:= buff^[bptr];
    IF LONG (bptr) = count - LONG (1) THEN  ReadBuffer (text);
                                      ELSE  INC (bptr);
    END; (* IF *)
   END; (* IF *)
  END; (* WITH *)
 END; (* IF *)
END ReadChar;

PROCEDURE ReadLine (text: TEXTFILE; VAR str: ARRAY OF CHAR);
VAR c: CARDINAL;
BEGIN
 IF text # NIL THEN
  WITH text^ DO
   IF mode = READ THEN
    c:= 0;
    LOOP
     IF eof THEN  str[c]:= 0C;  RETURN;  END;
     IF c > HIGH (str) THEN  RETURN  END;
     str[c]:= buff^[bptr];
     IF (str[c] = cr) OR (str[c] = lf) THEN
       str[c] := 0c; RETURN
     ELSE
      IF LONG (bptr) = count - LONG (1) THEN  ReadBuffer (text);
                                        ELSE  INC (bptr);
      END;
     END;
     INC (c);
    END; (* LOOP *)
   END; (* IF *)
  END; (* WITH *)
 END; (* IF *)
END ReadLine;

PROCEDURE ReadLn (text: TEXTFILE);
VAR ch: CHAR;
BEGIN
 IF text # NIL THEN
  WITH text^ DO
   IF (mode = READ) THEN
    LOOP
     ReadChar (text, ch);
(*
     IF (ch = 0C) OR (ch = lf) THEN RETURN
     ELSIF ch = cr
     THEN
                IF eof THEN RETURN;  END;
                ch:= buff^[bptr];
                IF ch = lf
                THEN
                  IF LONG (bptr) = count - LONG (1) THEN  ReadBuffer (text);
                                                    ELSE  INC (bptr);
                                                    END;
                END; (* IF *)
                RETURN;
     END;
*)
     CASE ch OF
      0C:       RETURN;|
      cr:       IF eof THEN RETURN;  END;
                ch:= buff^[bptr];
                IF ch = lf
                THEN
                  IF LONG (bptr) = count - LONG (1) THEN  ReadBuffer (text);
                                                    ELSE  INC (bptr);
                                                    END;
                END; (* IF *)
                RETURN;|
      lf:       RETURN;|
      ELSE      ;
     END; (* CASE *)
    END; (* LOOP *)
   END; (* IF *)
  END; (* WITH *)
 END; (* IF *)
END ReadLn;

PROCEDURE ReadSpec (text: TEXTFILE; REF check: ARRAY OF CHAR; VAR str: ARRAY OF CHAR);
VAR c:  CARDINAL;
    ch: CHAR;

 PROCEDURE Check (ch: CHAR): BOOLEAN;
 VAR x: CARDINAL;
 BEGIN
  FOR x:= 0 TO HIGH (check) DO
   IF ch = check[x] THEN  RETURN TRUE;  END;
  END;
  RETURN FALSE;
 END Check;

BEGIN
 str[0]:= 0C;  c:= 0;
 IF text # NIL THEN
  IF (text^.mode = READ) THEN
   REPEAT
    IF text^.eof THEN  RETURN;  END;
    ReadChar (text, ch);
   UNTIL Check (ch);
   REPEAT
    IF text^.eof THEN  str[c]:= 0C;  RETURN;  END;
    str[c]:= ch;  ReadChar (text, ch);  INC (c);
    IF c > HIGH (str) THEN  DEC (text^.bptr);  RETURN;
    END;
   UNTIL NOT Check (ch);
   DEC (text^.bptr);  str[c]:= 0C;
  END; (* IF *)
 END; (* IF *)
END ReadSpec;

PROCEDURE ReadCard (text: TEXTFILE; VAR wert: sCARDINAL);
BEGIN
 ReadSpec (text, '0123456789', string);
 wert:= StrToCard (string);
END ReadCard;

PROCEDURE ReadInt (text: TEXTFILE; VAR wert: sINTEGER);
BEGIN
 ReadSpec (text, '+-0123456789', string);
 wert:= StrToInt (string);
END ReadInt;

PROCEDURE ReadLongCard (text: TEXTFILE; VAR wert: lCARDINAL);
BEGIN
 ReadSpec (text, '0123456789', string);
 wert:= StrToLCard (string);
END ReadLongCard;

PROCEDURE ReadLongInt (text: TEXTFILE; VAR wert: lINTEGER);
BEGIN
 ReadSpec (text, '+-0123456789', string);
 wert:= StrToLInt (string);
END ReadLongInt;

PROCEDURE ReadReal (text: TEXTFILE; VAR wert: REAL);
BEGIN
 ReadSpec (text, '.+-0123456789E', string);
 wert:= StrToReal (string);
END ReadReal;

PROCEDURE ReadLongReal (text: TEXTFILE; VAR wert: LONGREAL);
BEGIN
 ReadSpec (text, '.+-0123456789E', string);
 wert:= StrToLReal (string);
END ReadLongReal;

END mtTextfiles.